﻿
Imports System.IO
Imports filesystem
Imports applicationInfoOutput

Namespace counter

    'since counter is just a helper of services, to avoid it broke current logic,
    'make most calls with on error resume next
    Public Module _counter
        Private Class counterRecord
            Public name As String = Nothing

            Public count As Int64 = 0
            Public lastAverages() As Int64
            Public lastAverageIndex As UInt64 = 0
            Public lastTimes() As DateTime
            Public lastTimeIndex As UInt64 = 0
            Public sampleRate As Double = 0

            Public writeType As Int16 = 0
            Public registerTime As DateTime
            Public intervalScale As Int64

            Private _flush As tally(Of _false) = Nothing

            Public Property flushtimes As Int16
                Get
                    Return _flush.step()
                End Get
                Set(ByVal value As Int16)
                    _flush.step = value
                End Set
            End Property

            Public Function calltimes() As Int64
                Return _flush.count()
            End Function

            Public Function needflush() As Boolean
                Return _flush.tick()
            End Function

            Public Function average() As Int64
                If calltimes() > 0 Then
                    Return count \ calltimes()
                Else
                    Return npos
                End If
            End Function

            Private Function lastAverageCount() As Int64
                If debugassert(Not lastAverages Is Nothing AndAlso lastAverages.Length() > 0, _
                               "lastAverages is not initialized, the counter may not enabled lastAverage.") Then
                    Dim c As Int64 = 0
                    Dim i As Int64
                    For i = 0 To lastAverages.Length() - 1
                        c += lastAverages(i)
                    Next
                    Return c
                Else
                    Return npos
                End If
            End Function

            Public Function lastAverage() As Int64
                Return lastAverageCount() \ lastAverages.Length()
            End Function

            Private Function timeInterval(ByVal f As DateTime, ByVal l As DateTime) As Int64
                Dim t As Int64
                t = ticksToSeconds((f.Ticks() - l.Ticks()) \ intervalScale)
                Return ifoper(t <= 0, 1, t)
            End Function

            Public Function rate() As Int64
                Return count \ timeInterval(Now, registerTime)
            End Function

            Public Function lastRate() As Int64
                If debugassert(Not lastTimes Is Nothing AndAlso lastTimes.Length() > 0, _
                               "lastTimes is not initialized, the counter may not enabled lastRate.") Then
                    Dim first As Int64
                    first = ifoper(Of Int64)(lastTimeIndex = 0, lastTimes.Length() - 1, lastTimeIndex - 1)
                    Return lastAverageCount() \ timeInterval(lastTimes(first), lastTimes(lastTimeIndex))
                Else
                    Return npos
                End If
            End Function

            Public Const writeCount As Int16 = 1
            Public Const writeAverage As Int16 = 2
            Public Const writeLastAverage As Int16 = 4
            Public Const writeRate As Int16 = 8
            Public Const writeLastRate As Int16 = 16

            Public Sub New()
                _flush = New tally(Of _false)()
            End Sub
        End Class

        'increase / decrease make a pair, so can get some detail information if set defaultflushtimes to an odd.
        'but ... it always be 0, 1, 0, 1, 0 ...
#If DEBUG Then
        Public Const defaultCounterFlushTimes As Int16 = 8
        Public Const defaultAverageFlushTimes As Int16 = 32
        Public Const defaultLastAverageFlushTimes As Int16 = 16
        Public Const defaultRateFlushTimes As Int16 = 32
        Public Const defaultLastRateFlushTimes As Int16 = 16
        Public Const defaultLastAverageLength As Int64 = 16
        Public Const defaultLastRateLength As Int64 = 16
        Public Const defaultIntervalScale As Int64 = 1
#Else
        Public Const defaultCounterFlushTimes As Int16 = 32
        Public Const defaultAverageFlushTimes As Int16 = 128
        Public Const defaultLastAverageFlushTimes As Int16 = 128
        Public Const defaultRateFlushTimes As Int16 = 128
        Public Const defaultLastRateFlushTimes As Int16 = 128
        Public Const defaultLastAverageLength As Int64 = 128
        Public Const defaultLastRateLength As Int64 = 128
        Public Const defaultIntervalScale As Int64 = 1
#End If
        Public Const defaultSampleRate As Double = 1
        Public Const separator As String = character.comma + character.blank
        Public Const NOCOUNTERFILEMARK As String = "___NOCOUNTERFILE___"
        Public Const fileNameSuffix As String = ".counter" + normalSuffix
        Public Const criticalFilenameSuffix As String = ".counter" + criticalSuffix
        Public ReadOnly defaultCounterPath As String = combinepath(deployRoot, "counter")
        Public ReadOnly defaultCounterFilename As String = generateDefaultFilename(defaultCounterPath)

        Public Event writeCounter(ByVal name As String, ByVal count As Int64)
        Private counters As memblock(Of counterRecord) = Nothing
        Private filestream As autoflushFileStream = Nothing
        Private initialized As Boolean = False

        Public Function countersCount() As Int64
            Return counters.size()
        End Function

        Public Function counter(ByVal index As Int64, _
                                ByRef name As String, _
                                Optional ByRef count As Int64 = 0, _
                                Optional ByRef average As Int64 = 0, _
                                Optional ByRef lastAverage As Int64 = 0, _
                                Optional ByRef rate As Int64 = 0, _
                                Optional ByRef lastRate As Int64 = 0) As Boolean
            If Not counters.availableIndex(index) Then
                Return False
            Else
                With counters(index)
                    copy(name, .name)
                    If .writeType And counterRecord.writeCount Then
                        count = .count
                    Else
                        count = npos
                    End If
                    If .writeType And counterRecord.writeAverage Then
                        average = .average()
                    Else
                        average = npos
                    End If
                    If .writeType And counterRecord.writeLastAverage Then
                        lastAverage = .lastAverage()
                    Else
                        lastAverage = npos
                    End If
                    If .writeType And counterRecord.writeRate Then
                        rate = .rate()
                    Else
                        rate = npos
                    End If
                    If .writeType And counterRecord.writeLastRate Then
                        lastRate = .lastRate()
                    Else
                        lastRate = npos
                    End If
                End With
                Return True
            End If
        End Function

        Public Function register(ByVal name As String, _
                                 Optional ByVal flushtimes As Int16 = defaultCounterFlushTimes, _
                                 Optional ByVal writeCount As Boolean = True, _
                                 Optional ByVal writeAverage As Boolean = False, _
                                 Optional ByVal writeLastAverage As Boolean = False, _
                                 Optional ByVal lastAverageLength As Int64 = defaultLastAverageLength, _
                                 Optional ByVal writeRate As Boolean = False, _
                                 Optional ByVal writeLastRate As Boolean = False, _
                                 Optional ByVal lastRateLength As Int64 = defaultLastRateLength, _
                                 Optional ByVal intervalScale As Int64 = defaultIntervalScale, _
                                 Optional ByVal sampleRate As Double = defaultSampleRate, _
                                 Optional ByVal autoInitialize As Boolean = True) As Int64
            If Not initialized AndAlso autoInitialize Then
                initial()
            End If
            On Error Resume Next
            strrplc(name, separator, "_")
            Dim rtn As Int64
            Dim cr As counterRecord = Nothing
            cr = New counterRecord()
            copy(cr.name, name)
            cr.flushtimes = flushtimes
            cr.intervalScale = ifoper(intervalScale <= 0, defaultIntervalScale, intervalScale)
            If writeCount Then
                cr.writeType = cr.writeType Or counterRecord.writeCount
            End If
            If writeAverage Then
                cr.writeType = cr.writeType Or counterRecord.writeAverage
            End If
            If writeLastAverage Then
                cr.writeType = cr.writeType Or counterRecord.writeLastAverage
            End If
            If writeLastAverage OrElse writeLastRate Then
                lastAverageLength = max(lastAverageLength, lastRateLength)
                ReDim cr.lastAverages(lastAverageLength - 1)
            End If
            If writeRate Then
                cr.writeType = cr.writeType Or counterRecord.writeRate
                copy(cr.registerTime, Now)
            End If
            If writeLastRate Then
                cr.writeType = cr.writeType Or counterRecord.writeLastRate
                ReDim cr.lastTimes(lastAverageLength - 1)
            End If
            cr.sampleRate = sampleRate

            SyncLock counters
                rtn = counters.size()
                counters += cr
            End SyncLock
            If isdebugmode() Then
                raiseError("register counter " + name + " with flushtimes " + Convert.ToString(flushtimes) + _
                           ", return ID " + Convert.ToString(rtn))
            End If

            Return rtn
        End Function

        Public Function registerCounter(ByVal name As String, _
                                        Optional ByVal flushtimes As Int16 = defaultCounterFlushTimes, _
                                        Optional ByVal sampleRate As Double = defaultSampleRate, _
                                        Optional ByVal autoInitialize As Boolean = True) As Int64
            Return register(name, flushtimes, sampleRate:=sampleRate, autoInitialize:=autoInitialize)
        End Function

        Public Function registerAverage(ByVal name As String, _
                                        Optional ByVal flushtimes As Int16 = defaultAverageFlushTimes, _
                                        Optional ByVal sampleRate As Double = defaultSampleRate, _
                                        Optional ByVal autoInitialize As Boolean = True) As Int64
            Return register(name, flushtimes, writeCount:=False, writeAverage:=True, _
                            sampleRate:=sampleRate, autoInitialize:=autoInitialize)
        End Function

        Public Function registerLastAverage(ByVal name As String, _
                                            Optional ByVal lastAverageLength As Int64 = defaultLastAverageLength, _
                                            Optional ByVal flushtimes As Int16 = defaultLastAverageFlushTimes, _
                                            Optional ByVal sampleRate As Double = defaultSampleRate, _
                                            Optional ByVal autoInitialize As Boolean = True) As Int64
            Return register(name, flushtimes, writeCount:=False, writeLastAverage:=True, _
                            lastAverageLength:=lastAverageLength, _
                            sampleRate:=sampleRate, autoInitialize:=autoInitialize)
        End Function

        Public Function registerAverageAndLastAverage(ByVal name As String, _
                                                      Optional ByVal lastAverageLength As Int64 = _
                                                          defaultLastAverageLength, _
                                                      Optional ByVal flushtimes As Int16 = _
                                                          defaultLastAverageFlushTimes, _
                                                      Optional ByVal sampleRate As Double = defaultSampleRate, _
                                                      Optional ByVal autoInitialize As Boolean = True) _
                                                      As Int64
            Return register(name, flushtimes, writeCount:=False, writeAverage:=True, writeLastAverage:=True, _
                            lastAverageLength:=lastAverageLength, _
                            sampleRate:=sampleRate, autoInitialize:=autoInitialize)
        End Function

        Public Function registerRate(ByVal name As String, _
                                     Optional ByVal intervalScale As Int64 = defaultIntervalScale, _
                                     Optional ByVal flushtimes As Int16 = defaultRateFlushTimes, _
                                     Optional ByVal sampleRate As Double = defaultSampleRate, _
                                     Optional ByVal autoInitialize As Boolean = True) As Int64
            Return register(name, flushtimes, writeCount:=False, writeRate:=True, _
                            intervalScale:=intervalScale, _
                            sampleRate:=sampleRate, autoInitialize:=autoInitialize)
        End Function

        Public Function registerLastRate(ByVal name As String, _
                                         Optional ByVal lastRateLength As Int64 = defaultLastRateLength, _
                                         Optional ByVal intervalScale As Int64 = defaultIntervalScale, _
                                         Optional ByVal flushtimes As Int16 = defaultLastRateFlushTimes, _
                                         Optional ByVal sampleRate As Double = defaultSampleRate, _
                                         Optional ByVal autoInitialize As Boolean = True) As Int64
            Return register(name, flushtimes, writeCount:=False, writeLastRate:=True, _
                            lastRateLength:=lastRateLength, intervalScale:=intervalScale, _
                            sampleRate:=sampleRate, autoInitialize:=autoInitialize)
        End Function

        Public Function registerRateAndLastRate(ByVal name As String, _
                                                Optional ByVal lastRateLength As Int64 = defaultLastRateLength, _
                                                Optional ByVal intervalScale As Int64 = defaultIntervalScale, _
                                                Optional ByVal flushtimes As Int16 = defaultLastRateFlushTimes, _
                                                Optional ByVal sampleRate As Double = defaultSampleRate, _
                                                Optional ByVal autoInitialize As Boolean = True) As Int64
            Return register(name, flushtimes, writeCount:=False, writeRate:=True, writeLastRate:=True, _
                            lastRateLength:=lastRateLength, intervalScale:=intervalScale, _
                            sampleRate:=sampleRate, autoInitialize:=autoInitialize)
        End Function

        Private Function patchCounterMsg(ByVal name As String, ByVal count As Int64) As String
            On Error Resume Next
            RaiseEvent writeCounter(name, count)
            Return shortTime() + separator + name + separator + Convert.ToString(count)
        End Function

        Private Function patchCounterMsg(ByVal name As String, ByVal count As Int64, _
                                         ByVal writetype As String) As String
            On Error Resume Next
            If Not writetype Is Nothing Then
                Return patchCounterMsg(name + character.underline + writetype, count)
            Else
                Return patchCounterMsg(name, count)
            End If
        End Function

        Public Function breakupCounterMsg(ByVal msg As String, _
                                          ByRef time As String, ByRef name As String, ByRef count As Int64) As Boolean
            On Error GoTo ext

            Dim index As Int64
            index = strindexof(msg, separator)
            If index = npos Then
                Return False
            Else
                time = strleft(msg, index)
                msg = strmid(msg, index + strlen(separator))

                index = strindexof(msg, separator)
                If index = npos Then
                    Return False
                Else
                    name = strleft(msg, index)
                    Dim str As String = Nothing
                    str = strmid(msg, index + strlen(separator))
                    If convertor.toint64(str, count) Then
                        Return True
                    Else
                        Return False
                    End If
                End If
            End If

ext:
            Return False
        End Function

        Private Sub write(ByVal id As Int64)
            On Error Resume Next

            With counters(id)
                If Not filestream.CanWrite Then
                    initial(defaultCounterFilename, criticalFilenameSuffix)
                End If
                If filestream.CanWrite Then
                    Dim msg As String = Nothing
                    Dim needwritetype As Boolean = False
                    needwritetype = bithelper._1count(.writeType) > 1
                    If .writeType And counterRecord.writeCount Then
                        msg += patchCounterMsg(.name, .count, _
                                               ifoper(needwritetype, "COUNT", Nothing)) + newline.incode()
                    End If
                    If .writeType And counterRecord.writeAverage Then
                        msg += patchCounterMsg(.name, .average(), _
                                               ifoper(needwritetype, "AVERAGE", Nothing)) + newline.incode()
                    End If
                    If .writeType And counterRecord.writeLastAverage Then
                        msg += patchCounterMsg(.name, .lastAverage(), _
                                               ifoper(needwritetype, _
                                                      "LAST" + Convert.ToString(.lastAverages.Length()) + "AVERAGE", _
                                                      Nothing)) + newline.incode()
                    End If
                    If .writeType And counterRecord.writeRate Then
                        msg += patchCounterMsg(.name, .rate(), _
                                               ifoper(needwritetype, "RATE", Nothing)) + newline.incode()
                    End If
                    If .writeType And counterRecord.writeLastRate Then
                        msg += patchCounterMsg(.name, .lastRate(), _
                                               ifoper(needwritetype, _
                                                      "LAST" + Convert.ToString(.lastTimes.Length()) + "RATE", _
                                                      Nothing)) + newline.incode()
                    End If
                    Dim d() As Byte
                    d = encoding.utf8.GetBytes(msg)
                    SyncLock filestream
                        filestream.Write(d, 0, d.Length())
                        filestream.Flush()
                    End SyncLock
                End If
            End With
        End Sub

        Public Function increase(ByVal id As Int64, Optional ByVal c As Int64 = 1) As Boolean
            On Error Resume Next

            If counters.availableIndex(id) Then
                SyncLock counters(id)
                    With counters(id)
                        If .sampleRate = 1 OrElse rnd() < .sampleRate Then
                            If (.writeType And counterRecord.writeCount) OrElse _
                               (.writeType And counterRecord.writeAverage) OrElse _
                               (.writeType And counterRecord.writeRate) Then
                                .count += c
                            End If

                            If .writeType And counterRecord.writeLastAverage OrElse _
                               .writeType And counterRecord.writeLastRate Then
                                'if we flush after 1000 calls, and only record 10 last averages,
                                'should only have 1/100 chance to write the data to last averages
                                If .lastAverages.Length() >= .flushtimes OrElse _
                                   rnd(0, 1) < .lastAverages.Length() / .flushtimes Then
                                    .lastAverages(.lastAverageIndex) = c
                                    .lastAverageIndex += 1
                                    If .lastAverageIndex = .lastAverages.Length() Then
                                        .lastAverageIndex = 0
                                    End If
                                End If
                            End If

                            If .writeType And counterRecord.writeLastRate Then
                                If .lastTimes.Length() >= .flushtimes OrElse _
                                   rnd(0, 1) < .lastTimes.Length() / .flushtimes Then
                                    copy(.lastTimes(.lastTimeIndex), Now)
                                    .lastTimeIndex += 1
                                    If .lastTimeIndex = .lastTimes.Length() Then
                                        .lastTimeIndex = 0
                                    End If
                                End If
                            End If

                            If Not filestream Is Nothing AndAlso .needflush() Then
                                write(id)
                            End If
                        End If
                    End With
                End SyncLock
                Return True
            Else
                Return False
            End If
        End Function

        Public Function decrease(ByVal id As Int64, Optional ByVal c As Int64 = 1) As Boolean
            Return increase(id, -c)
        End Function

        Public Sub initial(ByVal filename As String, Optional ByVal suffix As String = fileNameSuffix)
            On Error Resume Next

            generateFileStream(filestream, filename, suffix, NOCOUNTERFILEMARK)
            initialized = True
        End Sub

        Public Sub initial()
            initial(defaultCounterFilename)
        End Sub

        Private Sub unhandledException(ByVal ex As Exception)
            finalize()
        End Sub

        Public Sub finalize()
            On Error Resume Next

            If Not filestream Is Nothing Then
                Dim i As Int64
                For i = 0 To counters.size() - 1
                    SyncLock counters(i)
                        write(i)
                    End SyncLock
                Next
                closestream(filestream)
            End If
        End Sub

        Sub New()
            If Not isdebugmode() Then
                registerUnhandledException(AddressOf unhandledException)
            End If
            counters = New memblock(Of counterRecord)()
        End Sub
    End Module
End Namespace
